home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / wb1a1.lha / wb / db.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-06-29  |  11.6 KB  |  429 lines
  1. /* db.c: Scheme interface to WB functions
  2. Copyright (c) 1991, 1992, 1993 Holland Mark Martin
  3.  
  4. Permission to use, copy, modify, and distribute this software and its
  5. documentation for educational, research, and non-profit purposes and
  6. without fee is hereby granted, provided that the above copyright
  7. notice appear in all copies and that both that copyright notice and
  8. this permission notice appear in supporting documentation, and that
  9. the name of Holland Mark Martin not be used in advertising or
  10. publicity pertaining to distribution of the software without specific,
  11. written prior consent in each case.  Permission to incorporate this
  12. software into commercial products can be obtained from Jonathan
  13. Finger, Holland Mark Martin, 174 Middlesex Turnpike, Burlington, MA,
  14. 01803-4467, USA.  Holland Mark Martin makes no representations about
  15. the suitability or correctness of this software for any purpose.  It
  16. is provided "as is" without express or implied warranty.  Holland Mark
  17. Martin is under no obligation to provide any services, by way of
  18. maintenance, update, or otherwise. */
  19.  
  20.  
  21. #include "scm.h"
  22. /* #include "setjump.h" */
  23. #include "sys.h"
  24.  
  25. /* used for returns of bt-get bt-next bt-prev */
  26. static unsigned char buff[256];
  27.  
  28. static char s_iwb[] = "init-wb";
  29. SCM iwb(max_ents, max_buks, max_size)
  30.      SCM max_ents, max_buks, max_size;
  31. {
  32.   ASSERT(INUMP(max_ents),max_ents, ARG1, s_iwb);
  33.   ASSERT(INUMP(max_buks),max_buks, ARG2, s_iwb);
  34.   ASSERT(INUMP(max_size),max_size, ARG3, s_iwb);
  35.   return MAKINUM(init_wb(INUM(max_ents), INUM(max_buks), INUM(max_size)));
  36. }
  37.  
  38. SCM fwb()
  39. {
  40.   return MAKINUM(final_wb());
  41. }
  42.  
  43. static char s_open_seg[]="open-seg";
  44. SCM lopen_seg(seg, filename, mode)
  45.      SCM seg, filename, mode;
  46. {
  47.   ASSERT(INUMP(seg),seg,ARG1,s_open_seg);
  48.   ASSERT(NIMP(filename) && STRINGP(filename),filename,ARG2,s_open_seg);
  49.   return MAKINUM(open_seg(INUM(seg),UCHARS(filename),!(BOOL_F==mode || INUM0==mode)));
  50. }
  51.  
  52. static char s_close_seg[]="close-seg";
  53. SCM lclose_seg(seg,hammer)
  54.      SCM seg, hammer;
  55. {
  56.   ASSERT(INUMP(seg),seg,ARG1,s_close_seg);
  57.   return MAKINUM(close_seg(INUM(seg), NFALSEP(hammer)));
  58. }
  59.  
  60. static char s_make_seg[]="make-seg";
  61. SCM lmake_seg(seg,filename,bsiz)
  62.      SCM seg,filename,bsiz;
  63. {
  64.   ASSERT(INUMP(seg),seg,ARG1,s_make_seg);
  65.   ASSERT(NIMP(filename) && STRINGP(filename),filename,ARG2,s_make_seg);
  66.   ASSERT(INUMP(bsiz),bsiz,ARG3,s_make_seg);
  67.   return MAKINUM(make_seg(INUM(seg),UCHARS(filename),INUM(bsiz)));
  68. }
  69.  
  70. static char s_open_bt[]="open-bt";
  71. SCM lopen_bt(seg, blknum, wcb)
  72.      SCM seg, blknum, wcb;
  73. {
  74.   SCM bthan=makstr(sizeof (HAND));
  75.   ASSERT(INUMP(seg),seg,ARG1,s_open_bt);
  76.   ASSERT(INUMP(blknum),blknum,ARG2,s_open_bt);
  77.   ASSERT(INUMP(wcb),wcb,ARG3,s_open_bt);
  78.   if (!err_P(bt_open(INUM(seg),INUM(blknum),(HAND *)CHARS(bthan),INUM(wcb))))
  79.     return bthan;
  80.   else return BOOL_F;
  81. }
  82.  
  83. static char s_create_bt[]="create-bt";
  84. SCM lcreate_bt(seg, typ, wcb)
  85.      SCM seg, typ, wcb;
  86. {
  87.   SCM bthan=makstr(sizeof (HAND));
  88.   ASSERT(INUMP(seg),seg,ARG1,s_create_bt);
  89.   ASSERT(ICHRP(typ),typ,ARG2,s_create_bt);
  90.   ASSERT(INUMP(wcb),wcb,ARG3,s_create_bt);
  91.   if (!err_P(bt_create(INUM(seg),ICHR(typ),(HAND *)CHARS(bthan),INUM(wcb))))
  92.     return bthan;
  93.   else return BOOL_F;
  94. }
  95.  
  96. static char s_close_bt[]="close-bt!";
  97. SCM lclose_bt(bthan)
  98.      SCM bthan;
  99. {
  100.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_close_bt);
  101.   bt_close((HAND *)CHARS(bthan));
  102.   return UNSPECIFIED;
  103. }
  104.  
  105. int wrapproc(keystr, klen, vstr, vlen, long_tab)
  106.      unsigned char *keystr;
  107.      int klen;
  108.      unsigned char *vstr;
  109.      int vlen;
  110.      unsigned long *long_tab;
  111. {
  112.   /* put in dynwinds = ... to return unkerr and not allow reentry to wrapproc */
  113.   SCM res = apply((SCM)long_tab,
  114.           makfromstr(keystr,klen),
  115.           cons(makfromstr(vstr,vlen), listofnull));
  116.   if INUMP(res) return INUM(res);
  117.   if (BOOL_F==res) return notpres;
  118.   if (BOOL_T==res) return success;
  119.   if (IMP(res) || !STRINGP(res)) return typerr;
  120.   {
  121.     int i = LENGTH(res);
  122.     if (i > 255) return typerr;
  123.     while (i--) vstr[i] = CHARS(res)[i];
  124.     return LENGTH(res);
  125.   }
  126. }
  127.  
  128. /* lscan(bthan, op, key1, key2, scmproc, blklim)
  129.  returns a list of the success code, record count, and updated key. */
  130.  
  131. static char s_bt_scan[]="bt:scan";
  132. SCM lscan(bthan, op, args)
  133.      SCM bthan, op, args;
  134. {
  135.   SCM key1, key2, scmproc, blklim;
  136.   char ikey[256];
  137.   int ipkt[pkt_size], res;
  138.   set_skey_count(ipkt, 0);
  139.   ASSERT(4==ilength(args),args,WNA,s_bt_scan);
  140.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_scan);
  141.   ASSERT(INUMP(op), op, ARG2, s_bt_scan);
  142.   key1 = CAR(args); args = CDR(args);
  143.   ASSERT(NIMP(key1) && STRINGP(key1),key1,ARG3,s_bt_scan);
  144.   key2 = CAR(args); args = CDR(args);
  145.   ASSERT(NIMP(key2) && STRINGP(key2),key1,ARG4,s_bt_scan);
  146.   scmproc = CAR(args); args = CDR(args);
  147.   ASSERT(FALSEP(scmproc) || NIMP(scmproc) && BOOL_T==procedurep(scmproc),
  148.      scmproc, ARG5, s_bt_scan);
  149.   blklim = CAR(args); args = CDR(args);
  150.   ASSERT(INUMP(blklim), blklim, ARG5, s_bt_scan);
  151.   set_skey_len(ipkt, LENGTH(key1));
  152.   memcpy(ikey,CHARS(key1),LENGTH(key1));
  153.   res = bt_scan(CHARS(bthan), INUM(op),
  154.         ikey, skey_len(ipkt),
  155.         CHARS(key2), LENGTH(key2),
  156.         FALSEP(scmproc) ? 0 : wrapproc, scmproc,
  157.         ipkt, INUM(blklim));
  158.   return cons2(MAKINUM(res),
  159.            MAKINUM(skey_count(ipkt)),
  160.            cons(makfromstr(ikey,skey_len(ipkt)),EOL));
  161. }
  162.  
  163. static char s_bt_get[]="bt:get";
  164. SCM lbt_get(bthan, key)
  165.      SCM bthan, key;
  166. {
  167.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_get);
  168.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_get);
  169.   {
  170.     int tlen = bt_get((HAND *)CHARS(bthan),UCHARS(key),LENGTH(key),buff);
  171.     if (tlen >= 0) return makfromstr(buff, tlen);
  172.     return BOOL_F;
  173.   }
  174. }
  175.  
  176. static char s_bt_next[]="bt:next";
  177. SCM lbt_next(bthan, key)
  178.      SCM bthan, key;
  179. {
  180.   int klen = 0;
  181.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_next);
  182.   if FALSEP(key) {key=nullstr; klen = start_of_chain;}
  183.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_next);
  184.   if (!klen) klen = LENGTH(key);
  185.   if (!klen) {key=nullstr; klen = start_of_chain;}
  186.   {
  187.     int tlen = bt_next((HAND *)CHARS(bthan),UCHARS(key),klen,buff);
  188.     if (tlen >= 0) return makfromstr(buff, tlen);
  189.     return BOOL_F;
  190.   }
  191. }
  192.  
  193. static char s_bt_prev[]="bt:prev";
  194. SCM lbt_prev(bthan, key)
  195.      SCM bthan, key;
  196. {
  197.   int klen = 0;
  198.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_prev);
  199.   if FALSEP(key) {key=nullstr; klen = end_of_chain;}
  200.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_prev);
  201.   if (!klen) klen = LENGTH(key);
  202.   if (!klen) {key=nullstr; klen = start_of_chain;}
  203.   {
  204.     int tlen = bt_prev((HAND *)CHARS(bthan),UCHARS(key),klen,buff);
  205.     if (tlen >= 0) return makfromstr(buff, tlen);
  206.     return BOOL_F;
  207.   }
  208. }
  209.  
  210. static char s_bt_rem[]="bt:rem!";
  211. SCM lbt_rem(bthan, key)
  212.      SCM bthan, key;
  213. {
  214.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_rem);
  215.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_rem);
  216.   if (!bt_rem((HAND *)CHARS(bthan),UCHARS(key),LENGTH(key), 0L))
  217.     return BOOL_T;
  218.   else return BOOL_F;
  219. }
  220.  
  221. static char s_bt_read[]="bt:rem";
  222. SCM lbt_read(bthan, key)
  223.      SCM bthan, key;
  224. {
  225.   int tlen;
  226.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_read);
  227.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_read);
  228.   tlen = bt_rem((HAND *)CHARS(bthan),UCHARS(key),LENGTH(key), buff);
  229.   if (tlen >= 0) return makfromstr(buff,tlen);
  230.   return BOOL_F;
  231. }
  232.  
  233. static char s_bt_rem_star[]="bt:rem*";
  234. SCM lbt_rem_star(bthan, key, key2)
  235.      SCM bthan, key, key2;
  236. {
  237.   char tmpstr[256];
  238.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_rem_star);
  239.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_rem_star);
  240.   memcpy(tmpstr,CHARS(key),LENGTH(key));
  241.   if (!bt_rem_range((HAND *)CHARS(bthan),UCHARS(key),LENGTH(key),
  242.             UCHARS(key2), LENGTH(key2)?LENGTH(key2):end_of_chain))
  243.     return BOOL_T;
  244.   else return BOOL_F;
  245. }
  246.  
  247. static char s_bt_put[]="bt:put!";
  248. SCM lbt_put(bthan, key, val)
  249.      SCM bthan, key, val;
  250. {
  251.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_put);
  252.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_put);
  253.   ASSERT(NIMP(val) && STRINGP(val),val,ARG3,s_bt_put);
  254.   if (!bt_put((HAND *)CHARS(bthan),
  255.           UCHARS(key),LENGTH(key),
  256.           UCHARS(val),LENGTH(val)))
  257.     return BOOL_T;
  258.   else return BOOL_F;
  259. }
  260.  
  261. static char s_bt_write[]="bt:put";
  262. SCM lbt_write(bthan, key, val)
  263.      SCM bthan, key, val;
  264. {
  265.   ASSERT(NIMP(bthan) && STRINGP(bthan),bthan,ARG1,s_bt_write);
  266.   ASSERT(NIMP(key) && STRINGP(key),key,ARG2,s_bt_write);
  267.   ASSERT(NIMP(val) && STRINGP(val),val,ARG3,s_bt_write);
  268.   if (!bt_write((HAND *)CHARS(bthan),
  269.         UCHARS(key),LENGTH(key),
  270.         UCHARS(val),LENGTH(val)))
  271.     return BOOL_T;
  272.   else return BOOL_F;
  273. }
  274.  
  275. static char s_create_db[]="create-db";
  276. SCM lcreate_db(seg, typ, name)
  277.      SCM seg, typ, name;
  278. {
  279.   SCM a_han;
  280.   SCM d_han;
  281.   SCM tmp_str=makstr(5);
  282.   ASSERT(INUMP(seg),seg,ARG1,s_create_db);
  283.   ASSERT(ICHRP(typ),typ,ARG2,s_create_db);
  284.   ASSERT(NIMP(name) && STRINGP(name),name,ARG3,s_create_db);
  285.   a_han=lcreate_bt(seg,typ,INUM0);
  286.   d_han=lopen_bt(seg,MAKINUM(1),INUM0);
  287.   CHARS(tmp_str)[0]=4;
  288.   long2str(UCHARS(tmp_str), 1, han_id(CHARS(a_han)));
  289.   lbt_put(d_han,name,tmp_str);
  290.   lclose_bt(d_han);
  291.   return a_han;
  292. }
  293.  
  294. static char s_open_db[]="open-db";
  295. SCM lopen_db(seg, name)
  296.      SCM seg, name;
  297. {
  298.   SCM d_han, nn;
  299.   ASSERT(INUMP(seg),seg,ARG1,s_open_db);
  300.   ASSERT(NIMP(name) && STRINGP(name),name,ARG2,s_open_db);
  301.   d_han=lopen_bt(seg,MAKINUM(1),INUM0);
  302.   nn = lbt_get(d_han,name);
  303.   if (NIMP(nn) && STRINGP(nn) && (LENGTH(nn)>4) && (CHARS(nn)[0]==4))
  304.     return lopen_bt(seg, MAKINUM(str2long(UCHARS(nn)+1,0)),INUM0);
  305.   else return BOOL_F;
  306. }
  307.  
  308. SCM lcheck_access()
  309. {
  310.   check_access();
  311.   return UNSPECIFIED;
  312. }
  313.  
  314. SCM lclear()
  315. {
  316.   clear_stats();
  317.   return UNSPECIFIED;
  318. }
  319.  
  320. SCM lstats()
  321. {
  322.   stats();
  323.   return UNSPECIFIED;
  324. }
  325.  
  326. SCM lcstats()
  327. {
  328.   cstats();
  329.   return UNSPECIFIED;
  330. }
  331.  
  332. SCM lsb()
  333. {
  334.   sb();
  335.   return UNSPECIFIED;
  336. }
  337.  
  338. static char s_s2l[] = "str2long";
  339. SCM s2l(str, pos)
  340.      SCM str, pos;
  341. {
  342.   ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_s2l);
  343.   ASSERT(INUMP(pos), pos, ARG2, s_s2l);
  344.   ASSERT(LENGTH(str) >= INUM(pos) + 4, pos, OUTOFRANGE, s_s2l);
  345. #ifdef BIGDIG
  346.   {
  347.     unsigned long sl = str2long(CHARS(str), INUM(pos));
  348.     if (!POSFIXABLE(sl)) return long2big(sl);
  349.     return MAKINUM(sl);
  350.   }
  351. #else
  352.   return MAKINUM(str2long(CHARS(str), INUM(pos)));
  353. #endif
  354. }
  355.  
  356. static char s_l2s[] = "long2str!";
  357. SCM l2s(str, pos, clong)
  358.      SCM str, pos, clong;
  359. {
  360.   unsigned long clng = 0;
  361.   ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_l2s);
  362.   ASSERT(INUMP(pos), pos, ARG2, s_l2s);
  363.   ASSERT(NUMBERP(clong), clong, ARG3, s_l2s);
  364.   ASSERT(LENGTH(str) >= INUM(pos) + 4, pos, OUTOFRANGE, s_l2s);
  365. #ifdef BIGDIG
  366.   if NINUMP(clong) {
  367.     sizet l;
  368.     ASSERT(NIMP(clong) && TYP16(clong)==tc16_bigpos,clong,ARG1,s_l2s);
  369.     for(l = NUMDIGS(clong);l--;) clng = BIGUP(clng) + BDIGITS(clong)[l];
  370.   }
  371.   else
  372. #else
  373.     ASSERT(INUMP(clong),clong,ARG1,s_l2s);
  374. #endif
  375.   clng = INUM((unsigned long)clong);
  376.   long2str(CHARS(str), INUM(pos), clng);
  377.   return UNSPECIFIED;
  378. }
  379.  
  380. static iproc subr0s[]={
  381.     {"final-wb",fwb},
  382.     {"check-access!",lcheck_access},
  383.     {"clear-stats",lclear},
  384.     {"stats",lstats},
  385.     {"cstats",lcstats},
  386.     {"show-buffers",lsb},
  387.     {0,0}};
  388.  
  389. static iproc subr1s[]={
  390.     {s_close_bt,lclose_bt},
  391.     {0,0}};
  392.  
  393. static iproc subr2s[]={
  394.     {s_close_seg,lclose_seg},
  395.     {s_bt_get,lbt_get},
  396.     {s_bt_next,lbt_next},
  397.     {s_bt_prev,lbt_prev},
  398.     {s_bt_rem,lbt_rem},
  399.     {s_bt_read,lbt_read},
  400.     {s_open_db,lopen_db},
  401.     {s_s2l, s2l},
  402.     {0,0}};
  403.  
  404. static iproc subr3s[]={
  405.     {s_iwb,iwb},
  406.     {s_open_seg,lopen_seg},
  407.     {s_make_seg,lmake_seg},
  408.     {s_open_bt,lopen_bt},
  409.     {s_create_bt,lcreate_bt},
  410.     {s_bt_put,lbt_put},
  411.     {s_bt_write,lbt_write},
  412.     {s_create_db,lcreate_db},
  413.     {s_bt_rem_star,lbt_rem_star},
  414.     {s_l2s, l2s},
  415.     {0,0}};
  416.  
  417. void init_db()
  418. {
  419.   init_iprocs(subr0s, tc7_subr_0);
  420.   init_iprocs(subr1s, tc7_subr_1);
  421.   init_iprocs(subr2s, tc7_subr_2);
  422.   init_iprocs(subr3s, tc7_subr_3);
  423.   make_subr(s_bt_scan,tc7_lsubr_2,lscan);
  424. }
  425. void final_db()
  426. {
  427.   final_wb();
  428. }
  429.